home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / XREF.XPL < prev    next >
Text File  |  2001-09-30  |  7KB  |  259 lines
  1. \XREF.XPL    APR-25-87
  2. \Cross-reference generator for XPL programs.
  3. \ by Loren Blaney
  4. \This program demonstrates the use of binary search trees and linked lists.
  5. \ Ref:  Wirth, N., "Algorithms + Data Structures = Programs," (New Jersey:
  6. \ Prentice-Hall, 1976), pp. 206-210.
  7. \
  8. \REVISION HISTORY:
  9. \V1.4, Included underline (_) as an identifier character, L.B.
  10. \V1.5, General clean up, L.B.
  11. \V1.8, Fix "MEMORY FULL" bug caused by ED.XPL program (degenerate trees
  12. \ recurse a lot), L.B.
  13. \MAR-03-85, Modified for 32-bit XPL on the Stride, L.B.
  14. \OCT-20-86, Changed 'ELSE' to 'OTHER' in 'CASE' statements
  15. \APR-11-87, Changed string termination, 8 significant characters in a name.
  16. \APR-25-87, Fixed ^" inside strings.
  17.  
  18. code    RESERVE=3,    CHIN=7,        CHOUT=8,    CRLF=9,
  19.     INTIN=10,    INTOUT=11,    TEXT=12,    OPENI=13,
  20.     OPENO=14,    CLOSE=15,    FREE=18;
  21.  
  22. def    TV= 0, KB= 0, FILE= 3;        \I/O device numbers
  23. def    CR= $0D, LF= $0A, FF= $0C, TAB= $09, EOF= $1A, SP= $20;
  24.  
  25. def    INTSIZE= 4,    \Number of bytes in an integer
  26.     SIGCHAR= 8,    \Number of chars in an identifier
  27.     WIDTH= 95,    \Width of output device (characters)
  28.     NULL= 0;    \Empty entry
  29.  
  30. def    \TREEENTRY\    \Components of a tree entry
  31.     FIRST,        \Pointer to first entry in linked list
  32.     LAST,        \Pointer to last entry in linked list
  33.     LEFT,        \Pointer to left branch of tree
  34.     RIGHT,        \Pointer to right branch of tree
  35.     KEY;        \Identifier characters (must be last)
  36. def    \LISTENTRY\    \Components of a linked-list entry
  37.     LNO,        \Line number of identifier
  38.     NEXT;        \Pointer to next entry in the list
  39.  
  40. addr    IDENT;        \Identifier character array
  41. int    ROOT;        \Start of the search tree
  42. int    LEN,        \Index into IDENT array
  43.     LINENO,        \Current line no. of the listing
  44.     ODEV;        \Output device number
  45. reg int    CHAR;        \The current character read by GETCH
  46. addr    TOPMEM,        \Top of usable memory (heap) space +1
  47.     RAM;        \Pointer to allocated heap space
  48.  
  49.  
  50.  
  51. proc    GETCH;        \Get next character and print it
  52. begin
  53. CHAR:= CHIN(FILE);
  54. if CHAR # EOF then CHOUT(ODEV,CHAR);
  55. end;    \GETCH
  56.  
  57.  
  58.  
  59. func    ALLOCATE(AMOUNT);
  60. \"Reserves" memory, but, unlike the RESERVE intrinsic, this procedure
  61. \ doesn't return the space to the heap memory pool when the calling
  62. \ procedure returns.  In this respect allocate behaves like the Pascal
  63. \ intrinsic "NEW."
  64. int    AMOUNT;
  65. addr    TEMP;
  66. begin
  67. TEMP:= RAM;
  68. RAM:= RAM + AMOUNT;            \Reserve bytes
  69. if RAM >= TOPMEM then
  70.     begin
  71.     CRLF(TV); TEXT(TV, "OUT OF MEMORY - FILE IS TOO BIG");
  72.     CRLF(TV); exit;
  73.     end;
  74. return TEMP;
  75. end;    \ALLOCATE
  76.  
  77.  
  78.  
  79. proc    SEARCH(ADDRTREEENTRY);
  80. \Search the tree. If the identifier is not present then insert it.
  81. \ Otherwise, append the line number to the identifier's linked list.
  82. int    ADDRTREEENTRY;    \Address of pointer to the tree entry
  83. int    TREEENTRY,    \Pointer to the tree entry
  84.     LISTENTRY,    \Pointer to the linked-list entry
  85.     N;        \Scratch
  86. addr    ID;        \Identifier character string entry in tree
  87. begin
  88. TREEENTRY:= ADDRTREEENTRY(0);
  89. if TREEENTRY = NULL then        \Key is not in tree so insert it
  90.     begin
  91.     TREEENTRY:= ALLOCATE(SIGCHAR + 4 *INTSIZE);
  92.     LISTENTRY:= ALLOCATE(2 *INTSIZE);
  93.     ID:= TREEENTRY + KEY *INTSIZE;    \Point ID to identifier
  94.     for N:= 0, SIGCHAR-1 do ID(N):= IDENT(N);
  95.     TREEENTRY(LEFT):= NULL; TREEENTRY(RIGHT):= NULL;
  96.     TREEENTRY(FIRST):= LISTENTRY; TREEENTRY(LAST):= LISTENTRY;
  97.     LISTENTRY(LNO):= LINENO; LISTENTRY(NEXT):= NULL;
  98.     ADDRTREEENTRY(0):= TREEENTRY;    \Link up new entry
  99.     return;
  100.     end;
  101. ID:= TREEENTRY + KEY *INTSIZE;        \Point ID to identifier
  102. loop    begin
  103.     for N:= 0, SIGCHAR-1 do if IDENT(N)#ID(N) then quit;
  104.     LISTENTRY:= ALLOCATE(2 *INTSIZE); \Identifier found
  105.     LISTENTRY(LNO):= LINENO;    \Insert reference no.
  106.     LISTENTRY(NEXT):= NULL;
  107.     TREEENTRY(LAST,NEXT):= LISTENTRY;  \Link new entry in list
  108.     TREEENTRY(LAST):= LISTENTRY;     \Keep track of last entry
  109.     return;
  110.     end;
  111. if IDENT(N) < ID(N) then SEARCH(TREEENTRY + LEFT *INTSIZE)
  112.     \Pass the address of the pointer for the left branch
  113. else \IDENT(N) > ID(N)\ SEARCH(TREEENTRY + RIGHT *INTSIZE);
  114. end;    \SEARCH
  115.  
  116.  
  117.  
  118. proc    PRINTENTRY(TREEENTRY);
  119. \Print the identifier name followed by all of its line number references.
  120. \ I.e: print out one tree entry.
  121. int    TREEENTRY;
  122. int    COLUMN, LISTENTRY, I;
  123.  
  124.  
  125.     proc    STROUT(STR, SIZE);    \Output string to ODEV
  126.     addr    STR;
  127.     int    SIZE;
  128.     int    I;
  129.     begin
  130.     for I:=0, SIZE-1 do
  131.         CHOUT(ODEV, STR(I));
  132.     end;    \STROUT
  133.  
  134.  
  135.     proc    JUSTOUT(N);        \Output a right-justified integer
  136.     int    N;            \The field is 6 spaces wide
  137.     begin
  138.     CHOUT(ODEV, SP);
  139.     if N < 10000 then CHOUT(ODEV, SP);
  140.     if N < 1000 then CHOUT(ODEV, SP);
  141.     if N < 100 then CHOUT(ODEV, SP);
  142.     if N < 10 then CHOUT(ODEV, SP);
  143.     INTOUT(ODEV,N);
  144.     end;    \JUSTOUT
  145.  
  146.  
  147. begin
  148. STROUT(TREEENTRY + KEY *INTSIZE, SIGCHAR);    \Print identifier name
  149. CHOUT(ODEV, SP); CHOUT(ODEV, SP);    \Followed by two spaces
  150. COLUMN:= SIGCHAR +2;
  151.  
  152. \Print the line no. references by following the list linkages
  153. LISTENTRY:= TREEENTRY(FIRST);
  154. repeat    begin
  155.     if COLUMN+6 >= WIDTH then    \New line
  156.         [CRLF(ODEV);
  157.         for I:= 1, SIGCHAR+2 do CHOUT(ODEV, SP);
  158.         COLUMN:= SIGCHAR +2];
  159.     JUSTOUT(LISTENTRY(LNO));
  160.     COLUMN:= COLUMN +6;
  161.     LISTENTRY:= LISTENTRY(NEXT);
  162.     end;
  163. until LISTENTRY = NULL;
  164. CRLF(ODEV);
  165. end;    \PRINTENTRY
  166.  
  167.  
  168.  
  169. proc    PRINTTREE(TREEENTRY);
  170. \Prints the entire tree in (alphabetical) order.  I.e. print the cross-
  171. \ reference listing.
  172. int    TREEENTRY;
  173. begin
  174. if TREEENTRY # NULL then
  175.     begin
  176.     PRINTTREE(TREEENTRY(LEFT));
  177.     PRINTENTRY(TREEENTRY);
  178.     PRINTTREE(TREEENTRY(RIGHT));
  179.     end;
  180. end;    \PRINTTREE
  181.  
  182.  
  183.  
  184. proc    NEWLINE;    \Start a new line of the listing
  185. begin
  186. LINENO:= LINENO +1;
  187. INTOUT(ODEV, LINENO); CHOUT(ODEV, TAB);
  188. end;    \NEWLINE
  189.  
  190.  
  191.  
  192. begin    \MAIN
  193. IDENT:= RESERVE(SIGCHAR);
  194. RAM:= RESERVE(FREE-2000);        \Reserve memory for tree & lists
  195. TOPMEM:= RESERVE(0);            \Pointer to top of usable memory
  196.  
  197. TEXT(TV,"-- CROSS REFERENCE, V1.8x3 --
  198.  
  199. OUTPUT DEVICE? ");
  200.  
  201. ODEV:= INTIN(KB);
  202. OPENO(ODEV); OPENI(FILE);        \Initialize devices
  203.  
  204. ROOT:= NULL; LINENO:= 0;
  205. NEWLINE;
  206. GETCH;
  207. loop    begin
  208.     if CHAR = EOF then quit;
  209.     if CHAR>=^A & CHAR<=^Z then
  210.         begin            \Identifier found
  211.         LEN:= 0;
  212.         repeat    if LEN < SIGCHAR then
  213.                 [IDENT(LEN):= CHAR;
  214.                 LEN:= LEN +1];
  215.             GETCH;
  216.         until (CHAR<^A ! CHAR>^Z) & (CHAR<^0 ! CHAR>^9) & CHAR#^_;
  217.         \Fill out IDENT with spaces:
  218.         for LEN:= LEN, SIGCHAR-1 do IDENT(LEN):= ^ ;
  219.         SEARCH(addr ROOT);
  220.         end
  221.     else    begin               \Skip strings, comments,
  222.         case CHAR of        \ reserved words, etc.
  223.           ^":    [repeat    GETCH;
  224.                 if CHAR = ^^ then
  225.                     [GETCH;
  226.                     if CHAR = ^" then CHAR:= 0];
  227.                 if CHAR = EOF then quit;
  228.                 if CHAR = CR then NEWLINE;
  229.             until CHAR = ^";
  230.             GETCH];
  231.           ^\:    [repeat GETCH;
  232.                 if CHAR = EOF then quit;
  233.             until CHAR=^\ ! CHAR=CR;
  234.             if CHAR = ^\ then GETCH];
  235.           ^':    [repeat GETCH;
  236.                 if CHAR = EOF then quit;
  237.                 if CHAR = CR then NEWLINE;
  238.             until CHAR = ^';
  239.             GETCH];
  240.           ^^:    [GETCH;
  241.             if CHAR = EOF then quit;
  242.             if CHAR = CR then NEWLINE;
  243.             GETCH];
  244.           ^$:    repeat GETCH;
  245.             until (CHAR<^0 ! CHAR>^9) & (CHAR<^A ! CHAR>^F)
  246.         other    GETCH;
  247.         end;
  248.     if CHAR = CR then NEWLINE;
  249.     end;
  250. CRLF(ODEV);
  251. CHOUT(ODEV, FF);
  252. PRINTTREE(ROOT);
  253. CLOSE(ODEV);
  254. end;    \MAIN
  255. GETCH;
  256.         end;
  257.     if CHAR = CR then NEWLINE;
  258.     end;
  259. CRLF(ODEV)